00100	FEXPR COMPL FILE ← BEGIN SCALAR Z;
00200		EVAL('OUTPUT . ('DSK: . LIST (CAR FILE . 'LAP)))$
00300		EVAL('INPUT . ('DSK: . FILE))$
00400		INC('T ,NIL)$
00500		OUTC(T,NIL)$
00600	LOOP:	Z ← ERRSET(READ())$
00700		IF ATOM Z THEN GO TO DONE$
00800		Z ← CAR Z$
00900		IF CAR Z EQ 'DE THEN
01000	BEGIN SCALAR PROG;
01100		PROG ← COMP(CADR Z,CADDR Z,CADDDR Z)$
01200		MAPC(FUNCTION(PRINT),PROG)$
01300		OUTC(NIL,NIL)$
01400		PRINT LIST(CADR Z,LENGTH PROG)$
01500		OUTC(T,NIL)$
01600	END
01700		ELSE PRINT Z$
01800		GO TO LOOP$
01900	DONE:	OUTC(NIL,T)$
02000		INC(NIL,T)$
02100		RETURN 'ENDCOMP END;
02200	
02300	COMP(FN,VARS,EXP) ←
02400		(LAMBDA N;
02500			APPEND(
02600				LIST LIST('LAP,FN,'SUBR ),
02700				MKPUSH(N,1),
02800				COMPEXP(EXP,-N,PRUP(VARS,1)),
02900				LIST LIST ('SUB ,'P ,LIST('C ,0,0,N,N)),
03000				'((POPJ P) NIL)))
03100		LENGTH VARS;
03200	
03300	PRUP(VARS,N) ← IF NULL VARS THEN NIL
03400			ELSE (CAR VARS . N) . PRUP(CDR VARS,N+1);
03500	
03600	MKPUSH(N,M) ← IF N<M THEN NIL ELSE LIST('PUSH ,'P ,M).MKPUSH(N,M+1);
03700	
03800	COMPEXP(EXP,M,VPR) ←
03900		IF NULL EXP THEN '((MOVEI 1 0))
04000		ELSE IF EXP EQ 'T THEN '((MOVEI 1 (QUOTE T)))
04100		ELSE IF ATOM EXP THEN
04200			LIST LIST('MOVE ,1,M+CDR ASSOC(EXP,VPR),'P )
04300		ELSE IF CAR EXP EQ 'AND OR CAR EXP EQ 'OR OR
04400				CAR EXP EQ 'NOT THEN
04500			(LAMBDA L1,L2; APPEND(COMBOOL(EXP,M,L1,NIL,VPR),
04600				LIST('(MOVEI 1 (QUOTE T)),LIST('JRST ,0,L2),
04700				L1,'(MOVEI 1 0),L2)))
04800			(GENSYM(),GENSYM())
04900		ELSE IF CAR EXP EQ 'COND THEN 
05000			COMCOND(CDR EXP,M,GENSYM(),VPR)
05100		ELSE IF CAR EXP EQ 'QUOTE THEN LIST LIST('MOVEI,1,EXP)
05200		ELSE IF ATOM CAR EXP THEN
05300			(LAMBDA N; APPEND(COMPLIS(CDR EXP,M,VPR),
05400				LOADAC(1-N,1),
05500				LIST LIST('SUB ,'P ,LIST('C ,0,0,N,N)),
05600					LIST LIST('CALL ,N,
05700					LIST('E ,CAR EXP))))
05800				LENGTH CDR EXP
05900		ELSE IF CAAR EXP EQ 'LAMBDA THEN
06000			(LAMBDA N; APPEND(COMPLIS(CDR EXP,M,VPR),
06100				COMPEXP(CADDAR EXP,M-N,
06200				APPEND(PRUP(CADAR EXP,1-M),VPR)),
06300				LIST LIST('SUB ,'P ,LIST('C ,0,0,N,N))))
06400			LENGTH CDR EXP;
06500	
06600	COMPLIS(U,M,VPR) ←
06700		IF NULL U THEN NIL
06800		ELSE APPEND(COMPEXP(CAR U,M,VPR),
06900			'((PUSH P 1)),
07000				COMPLIS(CDR U,M-1,VPR));
07100	
07200	LOADAC(N,K) ← IF N>0 THEN NIL ELSE LIST('MOVE ,K,N,'P ).
07300				LOADAC(N+1,K+1);
07400	
07500	COMCOND(U,M,L,VPR) ←
07600		IF NULL U THEN LIST L
07700		ELSE (LAMBDA L1; APPEND(
07800			COMBOOL(CAAR U,M,L1,NIL,VPR),
07900			COMPEXP(CADAR U,M,VPR),
08000			LIST(LIST('JRST ,L),L1),
08100			COMCOND(CDR U,M,L,VPR)))
08200		GENSYM();
08300	
08400	COMBOOL(P,M,L,FLG,VPR) ←
08500		IF ATOM P THEN APPEND(COMPEXP(P,M,VPR),
08600				LIST LIST(IF FLG THEN 'JUMPN
08700					ELSE 'JUMPE ,1,L))
08800	
08900		ELSE IF CAR P EQ 'AND THEN
09000			(IF NOT FLG THEN COMPANDOR(CDR P,M,L,NIL,VPR)
09100			ELSE (LAMBDA L1; APPEND(
09200				COMPANDOR(CDR P,M,L1,NIL,VPR),
09300					LIST LIST('JRST ,0,L),
09400					LIST L1))
09500				GENSYM())
09600		ELSE IF CAR P EQ 'OR THEN
09700			(IF FLG THEN COMPANDOR(CDR P,M,L,T,VPR)
09800			ELSE (LAMBDA L1; APPEND(
09900					COMPANDOR(CDR P,M,L1,T,VPR),
10000					LIST LIST('JRST ,0,L),
10100					LIST L1))
10200				GENSYM())
10300		ELSE IF CAR P EQ 'NOT THEN
10400			COMBOOL(CADR P,M,L,NOT FLG,VPR)
10500		ELSE APPEND(COMPEXP(P,M,VPR),
10600				LIST LIST(IF FLG THEN 'JUMPN
10700					ELSE 'JUMPE ,1,L));
10800	
10900	COMPANDOR(U,M,L,FLG,VPR) ← IF NULL U THEN NIL
11000		ELSE APPEND(COMBOOL(CAR U,M,L,FLG,VPR),
11100				COMPANDOR(CDR U,M,L,FLG,VPR));
11200